Importação dos pacotes necessários e do dataset.

library(tidyverse)
library(car)
library(psych)
library(DescTools)
library(plotly)
library(lubridate)

df <- read_csv("advertising.csv")

Visão Geral do dataset importado, e informações adicionais

df %>% head(3) %>% knitr::kable(align = "llllllll")

df %>% str

## spec_tbl_df [1,000 × 8] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Daily Time Spent on Site: num [1:1000] 69 80.2 69.5 74.2 68.4 ...
##  $ Age                     : num [1:1000] 35 31 26 29 35 23 33 48 30 20 ...
##  $ Area Income             : num [1:1000] 61834 68442 59786 54806 73890 ...
##  $ City                    : chr [1:1000] "Wrightburgh" "West Jodi" "Davidton" "West Terrifurt" ...
##  $ Male                    : num [1:1000] 0 1 0 1 0 1 0 1 1 1 ...
##  $ Country                 : chr [1:1000] "Tunisia" "Nauru" "San Marino" "Italy" ...
##  $ Timestamp               : POSIXct[1:1000], format: "2016-03-27 00:53:11" "2016-04-04 01:39:02" ...
##  $ Clicked on Ad           : num [1:1000] 0 0 0 0 0 0 0 1 0 0 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   `Daily Time Spent on Site` = col_double(),
##   ..   Age = col_double(),
##   ..   `Area Income` = col_double(),
##   ..   City = col_character(),
##   ..   Male = col_double(),
##   ..   Country = col_character(),
##   ..   Timestamp = col_datetime(format = ""),
##   ..   `Clicked on Ad` = col_double()
##   .. )

Renomeando e alterando os tipos das variáveis

colnames(df) <- c('minutos diarios no site', 'idade', 'renda anual', 'cidade do cliente', 'sexo', 'nacionalidade',
       'horario que saiu do site', 'clicou no anuncio')

df$sexo <- as_factor(df$sexo) %>% lvls_revalue(c("feminino","masculino")) %>% relevel(ref = "masculino")
df$`horario que saiu do site` <- as.character(df$`horario que saiu do site`) %>% ymd_hms()
df$`clicou no anuncio` <- as_factor(df$`clicou no anuncio`) %>% lvls_revalue(c("nao","sim"))

df %>% head(3) %>% knitr::kable(align = "llllllll")

Verificando correlação entre as variáveis

Com isso, podemos ter uma ideia das variáveis mais importantes para análise e para o modelo preditivo.

pairs.panels(df[,c(8,1,2,3,5,7)])

OBS: É possivel notar que há 75% de correlação entre clicou no anuncio e minutos no site

Há 49% de correlação entre clicou no anuncio e idade.

48% de correlação entre clicou no anuncio e renda anual.

Também é possivel notar que sexo e horário em que saiu do site tem pouquíssima correlação não so com clicou no anuncio mas também com todas as outras variáveis.

Visualizando a distribuição de idade dos clientes

plot_ly(data = df, x=~idade, type = "histogram")

OBS: A maioria dos clientes estão na faixa dos 28 aos 40 anos

Visualizando quem clicou baseado na renda dos clientes e na idade

plot_ly( data = df, x=~`renda anual`, y=~idade, type = "scatter", color = ~`clicou no anuncio`, colors="Set1" )

OBS: É nítido que quanto maior a renda do cliente, menos interesse em anúncios, também é possível notar que as pessoas mais velhas e com uma renda menor, são as que mais clicam em anúncios.

Visualizando quantidade de tempo em minutos diários que os clientes navegam pelo site.

plot_ly(data=df, x=~`minutos diarios no site`, y=~idade, type = "scatter", color = ~`clicou no anuncio`, colors = c("darkmagenta","forestgreen"))

OBS: Curiosamente as pessoas que mais passam tempo navegando pelo site, são as que menos clicam nos anúncios

Criando modelo

O conjunto será particionado em dois, uma parte com 80% dos dados para treinar o modelo, e outra com 20% para testar o desempenho.

Como foi confirmado no gráfico de correlação que as únicas variáveis preditoras significantes para o modelo são minutos diarios no site, renda anual e idade , será criado modelos com estas variáveis.

Modelo 1: minutos diarios no site, renda anual e idade.

Modelo 2: minutos diarios no site e renda anual.

Modelo 3: apenas com minutos diarios no site.

indexTreino <- sample( 1:nrow(df), round(nrow(df) * 0.8)  )
dfTreino <- df[indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`,  `clicou no anuncio`)
dfTeste <- df[-indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`,  `clicou no anuncio`)


modelo1 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual` + idade)
modelo2 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual`)
modelo3 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site`)

Verificando desepenho dos modelos

Será utilizado a métrica AIC e BIC para comparar desempenho dos 3 modelos, quanto menor o valor retornado por essas métricas, melhor o modelo.

list( AIC(modelo1, modelo2, modelo3), BIC(modelo1, modelo2, modelo3) ) %>% knitr::kable(align = "ll")

OBS: Em ambas as métricas o modelo1 teve o melhor resultado.

Analisando coeficientes do melhor modelo

coef(modelo1)

##               (Intercept) `minutos diarios no site`             `renda anual` 
##              15.470611542              -0.208569650              -0.000121322 
##                     idade 
##               0.163886172

OBS: minutos diarios no site e renda anual influenciam negativamente em quem clica no anuncio, ou seja, quanto maior a renda ou o tempo que o cliente navega no site, maior a chance dele NÃO clicar nos anúncios, já a idade influencia de forma positiva, portanto, quanto mais velho o indivíduo, maior as chances do mesmo clicar em anúncios.

Verificando o quanto as variaveis preditoras explicam os resultados dos cliques

Será utilizada a métrica do pseudo R quadrado, que dá a porcentagem do quanto as variáveis preditoras escolhidas explicam a variável a ser predita.

PseudoR2(modelo1, which = "Nagelkerke")

## Nagelkerke 
##  0.8421176

OBS: As variáveis escolhidas explicam aproximadamente 80% dos resultados dos cliques em anúncios.

Verificando Outliers

Será verificado os valores dos resíduos padronizados, para identificar outliers, o resultado dos resíduos padronizados devem ser maiores que 2, ou menores que -2

dfTreino$N <- 1:nrow(dfTreino)
dfTreino$residuo_padronizado <- rstandard(modelo1)

plot_ly(data = dfTreino, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))

OBS: Podemos ver que alguns indivíduos são possíveis outliers

Verificando Pontos influentes

Antes de removermos os outliers, será verificado se estes influenciam de forma positiva no modelo, que seriam pontos influentes, para identificar estes individuos, será utilizado a métrica Distância de Cook.

É considerado um ponto influente, indivíduos com o valor da distância de cook próximo, igual ou maior que 1.

dfTreino$DistanciaCook <- cooks.distance(modelo1)
plot_ly(dfTreino, y=~DistanciaCook, x=~N, type = "scatter", marker=list(color="darkmagenta"))

OBS: Apesar de alguns indivíduos conterem o valor da distância de cook maior que o restante, não é o bastante para ser considerado um ponto influente

Removendo Outliers do dataset

será removido todo individuo que contenha residuos padronizados com valores maiores que 2 e menores que -2.

outliers <- filter(dfTreino, residuo_padronizado >= 2 | residuo_padronizado <= -2)$N
dfSemOutlier <- dfTreino[-outliers,]

Gerando o novo modelo sem os Outliers

modeloFinal <- glm(data = dfSemOutlier, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual` + idade)

Comparando o novo modelo com o modelo 1

list( AIC(modeloFinal, modelo1), BIC(modeloFinal, modelo1) ) %>% knitr::kable()

OBS: Como podemos ver, o modelo final teve um resultado superior

Testando o modelo

Antes do teste, será feito o teste de multicolinearidade.

Multicolinearidade é quando há uma correlação muito forte entre variáveis preditoras, o que pode ser prejudicial na eficácia do modelo, é considerado caso de multicolinearidade quando a correlação entre as variáveis preditoras ultrapassam dos 0.8(80%).

pairs.panels(dfTreino %>% select(`renda anual`, `minutos diarios no site`, idade))

OBS: Como podemos ver, não há multicolinearidade entre as variáveis preditoras